home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Database How-To
/
Visual Basic 4 Database - How-to (The Waite Group)(1995).iso
/
listbnd.fr_
/
listbnd.fr
Wrap
Text File
|
1995-07-04
|
10KB
|
311 lines
VERSION 4.00
Begin VB.Form Form1
BackColor = &H00C0C0C0&
Caption = "Bound Lister"
ClientHeight = 2685
ClientLeft = 1905
ClientTop = 1785
ClientWidth = 6420
BeginProperty Font
name = "MS Sans Serif"
charset = 1
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 3375
Left = 1845
LinkTopic = "Form1"
ScaleHeight = 2685
ScaleWidth = 6420
Top = 1155
Width = 6540
Begin VB.Data dtaPublishers
Caption = "Data1"
Connect = "Access"
DatabaseName = "C:\VB\BIBLIO.MDB"
Exclusive = 0 'False
Height = 300
Left = 3180
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "Publishers"
Top = 1980
Visible = 0 'False
Width = 1635
End
Begin VB.TextBox txtISBN
DataField = "ISBN"
DataSource = "dtaTitles"
Height = 315
Left = 4260
MaxLength = 13
TabIndex = 2
Top = 900
Width = 1635
End
Begin VB.TextBox txtYearPublished
DataField = "Year Published"
DataSource = "dtaTitles"
Height = 285
Left = 1860
TabIndex = 1
Top = 900
Width = 735
End
Begin VB.TextBox txtTitle
DataField = "Title"
DataSource = "dtaTitles"
Height = 555
Left = 1860
MultiLine = -1 'True
TabIndex = 0
Top = 180
Width = 4095
End
Begin VB.Data dtaTitles
Caption = "Titles"
Connect = "Access"
DatabaseName = "C:\VB\BIBLIO.MDB"
EOFAction = 2 'Add New
Exclusive = 0 'False
Height = 300
Left = 660
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "Titles"
Top = 2040
Width = 1815
End
Begin MSDBCtls.DBCombo dbcPublishers
Bindings = "LISTBND.frx":0000
DataField = "PubID"
DataSource = "dtaTitles"
Height = 315
Left = 1800
TabIndex = 7
Top = 1320
Width = 4095
_version = 65536
_extentx = 7223
_extenty = 556
_stockprops = 77
backcolor = 16777215
style = 2
listfield = "Name"
boundcolumn = "PubID"
End
Begin VB.Label Label4
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "Publisher ID:"
Height = 195
Left = 600
TabIndex = 6
Top = 1380
Width = 1110
End
Begin VB.Label Label3
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "ISBN:"
Height = 195
Left = 3600
TabIndex = 5
Top = 960
Width = 510
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "Year Published:"
Height = 195
Left = 360
TabIndex = 4
Top = 960
Width = 1350
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "Title:"
Height = 195
Left = 1200
TabIndex = 3
Top = 180
Width = 450
End
Begin VB.Menu mnuFile
Caption = "&File"
Begin VB.Menu mnuFileExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuEdit
Caption = "&Edit"
Begin VB.Menu mnuEditUndo
Caption = "&Undo"
Shortcut = %{BKSP}
End
End
Begin VB.Menu mnuData
Caption = "&Data"
Begin VB.Menu mnuDataAddRecord
Caption = "&Add Record"
End
Begin VB.Menu mnuDataDeleteRecord
Caption = "&Delete Record"
End
Begin VB.Menu mnuDataSaveRecord
Caption = "&Save Record"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private UpdateCancelled As Boolean
Private Sub dtaTitles_Validate(Action As Integer, Save As Integer)
Dim msg As String
'MsgBox Str$(Action) & " " & Str$(Save) & " " & dtaTitles.EditMode
UpdateCancelled = False
If Save = True Or Action = vbDataActionUpdate _
Or dtaTitles.Recordset.EditMode = dbEditAdd _
Then
' Either one or more bound controls has changed, or the Update
' method was invoked from code, or we're adding a new record.
' So verify that all fields have legal entries. If a field has
' an incorrect value, set the variable msg to a string explaining
' the error and set the focus to that field to facilitate the user's
' correcting the error.
If txtTitle = "" Then
msg = "You must enter a title."
txtTitle.SetFocus
ElseIf txtISBN = "" Then
msg = "You must enter an ISBN."
txtISBN.SetFocus
ElseIf txtYearPublished <> "" And Not IsNumeric(txtYearPublished) Then
msg = "The Year Published must be numeric."
txtYearPublished.SetFocus
ElseIf dbcPublishers.Text = "" Then
msg = "You must enter a numeric Publisher ID."
dbcPublishers.SetFocus
End If
End If
If msg <> "" Then
' We have something in the variable msg, which means that an error
' has occurred. Display the message for the user.
MsgBox msg, vbExclamation
' Cancel the Validate event
Action = vbDataActionCancel
' Set the form-level variable UpdateCancelled to True. This flags
' the Unload event to cancel the unload.
UpdateCancelled = True
Else
' No errors, so set the form level variable UpdateCancelled False
' to flag the Unload event to go ahead and proceed with the unload.
UpdateCancelled = False
End If
End Sub
Private Sub mnuEditUndo_Click()
If dtaTitles.EditMode = dbEditAdd Then
' The user clicked Undo while adding a new record, so cancel the
' AddNew operation.
dtaTitles.Recordset.CancelUpdate
' Now make a valid record the current record.
dtaTitles.Recordset.MoveLast
Else
' The user clicked Undo while editing an existing record, so reset
' values in the controls to values from the current recordset record.
dtaTitles.UpdateControls
End If
End Sub
Private Sub mnuFileExit_Click()
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
If UpdateCancelled Then
' The Validate event failed, so cancel the unload.
Cancel = True
ElseIf dtaTitles.Recordset.EditMode = dbEditAdd Then
' The Validate event succeeded, so write the new record to the
' recordset.
dtaTitles.Recordset.Update
End If
End Sub
Private Sub mnuDataSaveRecord_Click()
' The user clicked SaveRecord, so call the Update method to transfer
' the values in the bound controls to their respective fields.
dtaTitles.Recordset.Update
End Sub
Private Sub mnuDataAddRecord_Click()
' The user clicked Add Record. Reset all controls to the default for a
' new record and make space in the copy buffer for a new recpord.
dtaTitles.Recordset.AddNew
' The default for Year Published in the database is 0. Change it to
' nothing.
txtYearPublished = ""
' Set the focus to the first control on the form.
txtTitle.SetFocus
End Sub
Private Sub mnuDataDeleteRecord_Click()
Dim msg As String
' Verify that the user wants to delete the record.
msg = "Are you sure you want to delete "
msg = msg & IIf(txtTitle <> "", txtTitle, "this record") & "?"
If MsgBox(msg, vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
' The user wants to delete, so delete the record.
dtaTitles.Recordset.Delete
' Make a valid record the current record.
dtaTitles.Recordset.MoveNext
' If we just deleted the last record in the recordset,
' position the recordpointer on the new last record.
If dtaTitles.Recordset.EOF Then dtaTitles.Recordset.MoveLast
End If
End Sub